home *** CD-ROM | disk | FTP | other *** search
/ Mac Magazin/MacEasy 21 / Mac Magazin and MacEasy Magazine CD - Issue 21.iso / Wissenschaft & Technik / yorick12vr1-nofpu folder / include / testb.i < prev    next >
Text File  |  1995-07-26  |  28KB  |  935 lines
  1. /*
  2.    TESTB.I
  3.    A comprehensive test of the native-Yorick binary I/O functions.
  4.  
  5.    Also, read back PDB files created by Stewart Brown's pdtest program,
  6.    and create facsimile of such files (although doesn't write PDB-style
  7.    pointers).
  8.  
  9.    $Id: testb.i,v 1.1 1993/08/27 18:50:06 munro Exp $
  10.  */
  11. /*    Copyright (c) 1994.  The Regents of the University of California.
  12.                     All rights reserved.  */
  13.  
  14. func testb(do_stats)
  15. /* DOCUMENT testb
  16.          or testb, 1      (prints yorick_stats)
  17.      Perform systematic test of all features of Yorick's binary I/O
  18.      package.  This extends the simple test in testp.i.
  19.  */
  20. {
  21.   local varCs, varCa, varSs, varSa, varIs, varIa, varLs, varLa;
  22.   local varFs, varFa, varDs, varDa, varZs, varZa, varSIs, varSIa;
  23.   local bundle;
  24.   local varQs, varPs, varQa, varPa, linkedList, mixed;
  25.  
  26.   /* begin by writing a simple flat file */
  27.   write, "  First test is to write flat files:";
  28.   tester1, "junk", write_flat, read_flat;
  29.  
  30.   /* continue by writing a file with lots of indirections */
  31.   write, "\n  Second test is to write files with pointers:";
  32.   tester1, "junk", write_ptrs, read_ptrs;
  33.  
  34.   /* update the indirect files and write the flat stuff */
  35.   write, "\n  Third test is to update pointered files with flat data:";
  36.   tester2, "junk", write_flat, read_flat, read_ptrs;
  37.  
  38.   now= split= array(0.0, 3);
  39.   timer, now;
  40.   /* exhaustive test to and from all other primitive formats */
  41.   write, "\n  Fourth test is exhaustive check of other primitive formats:";
  42.   tester3;
  43.   timer, now, split;
  44.   timer_print, "Time to write and test all file formats", split;
  45.  
  46.   /* Contents Log tests */
  47.   write, "\n  Fifth test is check of Contents Log machinery:";
  48.   tester4;
  49.  
  50.   now= array(0.0, 3);
  51.   timer, now;
  52.   start= now;
  53.   /* History tests */
  54.   write, "\n  Sixth test is flat history files (be patient):";
  55.   tester5;
  56.   timer, now;
  57.   now -= start;
  58.   write, "Time to write history files ", now(1)+now(2);
  59.  
  60.   write, "\n  Seventh test is a pointered history file:";
  61.   tester6;
  62.  
  63.   rm_hist;
  64.   remove, "junk.clog";
  65.   remove, "junk.pdb";  remove, "junk.pdbL";
  66.   remove, "junkd.pdb";  remove, "junkd.pdbL";
  67.   remove, "junkc.pdb";  remove, "junkc.pdbL";
  68.   remove, "junks.pdb";  remove, "junks.pdbL";
  69. }
  70.  
  71. func rm_hist
  72. {
  73.   for (i=0 ; i<22 ; i++) remove, swrite(format="junk%02ld.pdb", i);
  74.   for (i=0 ; i<22 ; i++) remove, swrite(format="junk%02ld.pdbL", i);
  75. }
  76.  
  77. func tester1(base, writer, reader)
  78. {
  79.   if (do_stats) "Begin1  "+print(yorick_stats())(1);
  80.   write, "Write using native formats"
  81.   f= createb(base+".pdb");
  82.   if (do_stats) "Created  "+print(yorick_stats())(1);
  83.  
  84.   writer, f, 0;
  85.  
  86.   close, f;
  87.   if (do_stats) "Closed   "+print(yorick_stats())(1);
  88.  
  89.   f= openb(base+".pdb");
  90.   if (do_stats) "Opened   "+print(yorick_stats())(1);
  91.  
  92.   reader, f, 0;
  93.  
  94.   write, "Write using DEC primitive formats"
  95.   g= createb(base+"d.pdb", dec_primitives);
  96.   if (do_stats) "Created  "+print(yorick_stats())(1);
  97.  
  98.   writer, g, 1;
  99.   reader, g, 0;
  100.  
  101.   write, "Write using Sun primitive formats"
  102.   h= createb(base+"s.pdb", sun_primitives);
  103.   if (do_stats) "Created  "+print(yorick_stats())(1);
  104.  
  105.   writer, h, 0;
  106.   reader, h, 1;
  107.   close, h;
  108.   if (do_stats) "Closed S "+print(yorick_stats())(1);
  109.  
  110.   write, "Write using Cray primitive formats"
  111.   h= createb(base+"c.pdb", cray_primitives);
  112.   if (do_stats) "Created  "+print(yorick_stats())(1);
  113.  
  114.   writer, h, 1;
  115.   reader, h, 1;
  116.  
  117.   close, h;
  118.   if (do_stats) "Closed C "+print(yorick_stats())(1);
  119.   close, g;
  120.   if (do_stats) "Closed D "+print(yorick_stats())(1);
  121.   close, f;
  122.   if (do_stats) "Closed N "+print(yorick_stats())(1);
  123. }
  124.  
  125. func tester2(base, writer, reader, reader2)
  126. {
  127.   if (do_stats) "Begin2  "+print(yorick_stats())(1);
  128.   write, "Update using native formats"
  129.   f= updateb(base+".pdb");
  130.   if (do_stats) "Updating "+print(yorick_stats())(1);
  131.  
  132.   writer, f, 1;
  133.  
  134.   close, f;
  135.   if (do_stats) "Closed   "+print(yorick_stats())(1);
  136.  
  137.   f= updateb(base+".pdb");
  138.   if (do_stats) "Opened   "+print(yorick_stats())(1);
  139.  
  140.   reader, f, 1;
  141.   reader2, f, 1;
  142.  
  143.   write, "Update using DEC primitive formats"
  144.   g= updateb(base+"d.pdb", dec_primitives);
  145.   if (do_stats) "Updating "+print(yorick_stats())(1);
  146.  
  147.   writer, g, 0;
  148.   reader, g, 1;
  149.   reader2, g, 1;
  150.  
  151.   write, "Update using Sun primitive formats"
  152.   h= updateb(base+"s.pdb", sun_primitives);
  153.   if (do_stats) "Created  "+print(yorick_stats())(1);
  154.  
  155.   writer, h, 1;
  156.   reader, h, 0;
  157.   reader2, h, 0;
  158.   close, h;
  159.   if (do_stats) "Closed S "+print(yorick_stats())(1);
  160.  
  161.   write, "Update using Cray primitive formats"
  162.   h= updateb(base+"c.pdb", cray_primitives);
  163.   if (do_stats) "Created  "+print(yorick_stats())(1);
  164.  
  165.   writer, h, 0;
  166.   reader, h, 0;
  167.   reader2, h, 0;
  168.  
  169.   close, h;
  170.   if (do_stats) "Closed C "+print(yorick_stats())(1);
  171.   close, g;
  172.   if (do_stats) "Closed D "+print(yorick_stats())(1);
  173.   close, f;
  174.   if (do_stats) "Closed N "+print(yorick_stats())(1);
  175. }
  176.  
  177. func tester3
  178. {
  179.   write, "Testing Sun format";
  180.   test_full, "junk", sun_primitives;
  181.  
  182.   write, "Testing DEC format";
  183.   test_full, "junk", dec_primitives;
  184.  
  185.   write, "Testing Cray format";
  186.   test_full, "junk", cray_primitives;
  187.  
  188.   write, "Testing XDR format";
  189.   test_full, "junk", xdr_primitives;
  190.  
  191.   write, "Testing Mac format";
  192.   test_full, "junk", mac_primitives;
  193.  
  194.   write, "Testing Mac long-double format";
  195.   test_full, "junk", macl_primitives;
  196.  
  197.   write, "Testing IBM PC format";
  198.   test_full, "junk", pc_primitives;
  199.  
  200.   write, "Testing VAX format";
  201.   test_full, "junk", vax_primitives;
  202.  
  203.   write, "Testing VAX G-double format";
  204.   test_full, "junk", vaxg_primitives;
  205.  
  206.   write, "Testing Sun-3/Sun-2 format";
  207.   test_full, "junk", sun3_primitives;
  208.  
  209.   write, "Testing native format";
  210.   test_full, "junk";
  211. }
  212.  
  213. func test_full(base, primitives)
  214. {
  215.   write_ptrs, createb(base+".pdb", primitives), 0;
  216.   write_flat, updateb(base+".pdb"), 0;
  217.   read_flat, openb(base+".pdb"), 0;
  218.   read_ptrs, openb(base+".pdb"), 0;
  219. }
  220.  
  221. func tester4
  222. {
  223.   write, "Contents Log -- testing Sun format";
  224.   test_clog, "junk", sun_primitives;
  225.  
  226.   write, "Contents Log -- testing DEC format";
  227.   test_clog, "junk", dec_primitives;
  228.  
  229.   write, "Contents Log -- testing Cray format";
  230.   test_clog, "junk", cray_primitives;
  231.  
  232.   write, "Contents Log -- testing VAX format";
  233.   test_clog, "junk", vax_primitives;
  234.  
  235.   write, "Contents Log -- testing native format";
  236.   test_clog, "junk";
  237.  
  238.   write, "Non-PDB Contents Log -- testing Sun format";
  239.   test_clog, "junk", sun_primitives, 1;
  240.  
  241.   write, "Non-PDB Contents Log -- testing DEC format";
  242.   test_clog, "junk", dec_primitives, 1;
  243.  
  244.   write, "Non-PDB Contents Log -- testing Cray format";
  245.   test_clog, "junk", cray_primitives, 1;
  246.  
  247.   write, "Non-PDB Contents Log -- testing VAX format";
  248.   test_clog, "junk", vax_primitives, 1;
  249.  
  250.   write, "Non-PDB Contents Log -- testing native format";
  251.   test_clog, "junk",, 1;
  252. }
  253.  
  254. func test_clog(base, primitives, nonpdb)
  255. {
  256.   if (!nonpdb) {
  257.     f= createb(base+".pdb", primitives);
  258.   } else {
  259.     f= open(base+".pdb", "w+b");
  260.     if (is_func(primitives)) primitives, f;
  261.     _init_clog, f;
  262.   }
  263.   write_ptrs, f, 0;
  264.   write_flat, f, 0;
  265.   if (!nonpdb) dump_clog, f, base+".clog";
  266.   close, f;
  267.   if (!nonpdb) f= openb(base+".pdb", base+".clog");
  268.   else f= openb(base+".pdb");
  269.   read_flat, f, 0;
  270.   read_ptrs, f, 0;
  271. }
  272.  
  273. func tester5
  274. {
  275.   write, "History -- testing Sun format";
  276.   test_hist, "junk00", sun_primitives;
  277.   rm_hist;
  278.  
  279.   write, "History -- testing DEC format";
  280.   test_hist, "junk00", dec_primitives;
  281.   rm_hist;
  282.  
  283.   write, "History -- testing Cray format";
  284.   test_hist, "junk00", cray_primitives;
  285.   rm_hist;
  286.  
  287.   write, "History -- testing VAX format";
  288.   test_hist, "junk00", vax_primitives;
  289.   rm_hist;
  290.  
  291.   write, "History -- testing native format";
  292.   test_hist, "junk00";
  293.   rm_hist;
  294. }
  295.  
  296. func test_hist(base, primitives)
  297. {
  298.   /* No non-record variables in 1st test.  */
  299.   f= createb(base+".pdb", primitives);
  300.   write_hist, f;
  301.   close, f;
  302.  
  303.   f= openb(base+".pdb");
  304.   read_hist, f;
  305.   close, f;
  306. }
  307.  
  308. test_records= 100;
  309. test_filesize= 8000;   /* each record is about 1 kbyte long */
  310.  
  311. func write_hist(f)
  312. {
  313.   for (i=1 ; i<=test_records ; i++) {
  314.     time= double(i-1);  ncyc= i;
  315.     add_record, f, time, ncyc;
  316.     if (i==1) set_filesize, f, test_filesize;
  317.     save, f, time, ncyc;
  318.     write_flat, f, 0;
  319.   }
  320. }
  321.  
  322. func read_hist(f)
  323. {
  324.   n= test_records/3;
  325.   prime= 27;
  326.   if (n%prime == 0) {
  327.     prime= 13;
  328.     if (n%prime == 0) prime= 0;
  329.   }
  330.   for (i=1 ; i<=test_records/3 ; i++) {
  331.     if (prime) j= (i%prime) + 1;
  332.     else j= i;
  333.     jt, double(j-1);
  334.     if (f.time!=double(j-1) || f.ncyc!=j)
  335.       "time or ncyc bad at record "+print(j)(1);
  336.     read_flat, f, 0;
  337.   }
  338.   for (i=test_records/3+1 ; i<=2*(test_records/3) ; i++) {
  339.     jc, f, i;
  340.     if (f.time!=double(i-1) || f.ncyc!=i)
  341.       "time or ncyc bad at record "+print(i)(1);
  342.     read_flat, f, 0;
  343.   }
  344.   i= 2*(test_records/3);
  345.   do {
  346.     restore, f, time, ncyc;
  347.     if (f.time!=double(i-1) || f.ncyc!=i)
  348.       "time or ncyc bad at record "+print(i)(1);
  349.     read_flat, f, 0;
  350.     i++;
  351.   } while (jt(f));
  352.   if (ncyc<test_records) "jt found only "+print(ncyc)(1)+
  353.     " out of "+print(test_records)(1)+" records";
  354. }
  355.  
  356. func tester6
  357. {
  358.   for_hist_test= 1;
  359.  
  360.   f= createb("junk00.pdb");
  361.   write_flat, f, 1;
  362.   for (i=1 ; i<=23 ; i++) {
  363.     time= double(i-1);  ncyc= i;
  364.     if (i==1) {
  365.       /* records with pointers must be built before writing them */
  366.       add_record, f;
  367.       add_variable, f, -1, "varQs", string;
  368.       add_variable, f, -1, "varQa", string, 2, 4;
  369.       add_variable, f, -1, "varPs", pointer;
  370.       add_variable, f, -1, "varPa", pointer, 2, 3, 2;
  371.       add_variable, f, -1, "linkedList", pointer;
  372.       add_variable, f, -1, "mixed", Mixed;
  373.       save, f, Link;
  374.     }
  375.     add_record, f, time, ncyc;
  376.     if (i==1) set_filesize, f, test_filesize;
  377.     save, f, time, ncyc;
  378.     write_ptrs, f, 0;
  379.   }
  380.   close, f;
  381.  
  382.   f= openb("junk00.pdb");
  383.   for (i=1 ; i<=23 ; i++) {
  384.     j= (17*i)%23 + 1;
  385.     jt, double(j-1);
  386.     if (f.time!=double(j-1) || f.ncyc!=j)
  387.       "time or ncyc bad at record "+print(j)(1);
  388.     read_ptrs, f, 1;
  389.     read_flat, f, 1;
  390.   }
  391.   close, f;
  392.  
  393.   rm_hist;
  394. }
  395.  
  396. func write_flat(f, how)
  397. {
  398.   extern varCs, varCa, varSs, varSa, varIs, varIa, varLs, varLa;
  399.   extern varFs, varFa, varDs, varDa, varZs, varZa, varSIs, varSIa;
  400.   extern bundle;
  401.  
  402.   /* invent a bunch of garbage to be written */
  403.   varCs= 'A';  varSs= -37s;  varIs= 76n;  varLs= 144;
  404.   varCa= ['Z', '\370', 'a'];
  405.   varSa= short([[0,0,0],[0,-100,100]]);
  406.   varIa= int([[[1,2,3,4],[-30,-20,-10,0],[-1,2,-3,4]],
  407.           [[0,-30,20,-10],[4,3,2,1],[3,-4,1,-2]]]);
  408.   varLa= [123456789, -987654321];
  409.   varFs= 1.5f;  varDs= -6.022e23;  varZs= 1-1i;
  410.   varFa= float([[0,0,0],[0,-100,100]]);
  411.   varDa= double([[[1,2,3,4],[-30,-20,-10,0],[-1,2,-3,4]],
  412.          [[0,-30,20,-10],[4,3,2,1],[3,-4,1,-2]]]);
  413.   varZa= [123456789-3.5i, -987654321+0i];
  414.  
  415.   varSIs= Simple(one='Q', two= -137., three= -37s);
  416.   varSIa= [varSIs, Simple(one='\370', two= 1.5, three= 37s)];
  417.  
  418.   bundle= Flat(varCs=varCs, varSs=varSs, varIs=varIs, varLs=varLs,
  419.            varCa=varCa, varSa=varSa, varIa=varIa, varLa=varLa,
  420.            varFs=varFs, varDs=varDs, varZs=varZs, varSIs=varSIs,
  421.            varFa=varFa, varDa=varDa, varZa=varZa, varSIa=varSIa);
  422.  
  423.   if (!how) {
  424.     save, f, varCs, varSs, varIs, varLs, varCa, varSa, varIa, varLa;
  425.     save, f, varFs, varDs, varZs, varSIs, varFa, varDa, varZa, varSIa;
  426.     save, f, bundle;
  427.   } else {
  428.     add_variable, f, -1, "varCs", char;
  429.     add_variable, f, -1, "varSs", "short";
  430.     add_variable, f, -1, "varIs", int;
  431.     add_variable, f, -1, "varLs", "long";
  432.     add_variable, f, -1, "varCa", "char", 3;
  433.     add_variable, f, -1, "varSa", short, 3, 2;
  434.     add_variable, f, -1, "varIa", "int", 4, [2,3,2];
  435.     add_variable, f, -1, "varLa", long, [1,2];
  436.  
  437.     save, f, varFs, varDs;
  438.  
  439.     add_variable, f, -1, "varZs", complex;
  440.     f.varZs.re= varZs.re;
  441.     f.varZs.im= varZs.im;
  442.  
  443.     add_variable, f, -1, "varFa", "float", [1,3], [1,2];
  444.     add_variable, f, -1, "varDa", double, [2,4,3], 2;
  445.     add_variable, f, -1, "varZa", "complex", 2;
  446.  
  447.     add_member, f, "Simple", -1, "one", char;
  448.     add_member, f, "Simple", -1, "two", "double";
  449.     add_member, f, "Simple", -1, "three", short;
  450.     install_struct, f, "Simple";
  451.  
  452.     add_variable, f, -1, "varSIs", Simple;
  453.     add_variable, f, -1, "varSIa", "Simple", 2;
  454.     add_variable, f, -1, "bundle", Flat;
  455.  
  456.     f.varCs= varCs;
  457.     save, f, varCa, varSs, varIs, varLs;
  458.     f.varSa= varSa;
  459.     f.varIa(::-1,,1)= varIa(::-1,,1);
  460.     f.varIa(,::-1,2)= varIa(,::-1,2);
  461.     f.varLa= varLa;
  462.     f.varFa([3,1,5,2,4,6])= varFa([3,1,5,2,4,6]);
  463.     f.varDa(,[3,1,5,2,4,6])= varDa(,[3,1,5,2,4,6]);
  464.     f.varZa(1).re= varZa.re(1);
  465.     f.varZa(1).im= varZa.im(1);
  466.     f.varZa.re(2)= varZa(2).re;
  467.     f.varZa.im(2)= varZa(2).im;
  468.     f.varSIs.one= varSIs.one;
  469.     f.varSIs.two= varSIs.two;
  470.     f.varSIs.three= varSIs.three;
  471.     f.varSIa.one= varSIa.one;
  472.     f.varSIa.two= varSIa.two;
  473.     f.varSIa(1).three= varSIa.three(1);
  474.     f.varSIa.three(2)= varSIa(2).three;
  475.     save, f, bundle;
  476.   }
  477.  
  478.   if (do_stats) "Saved    "+print(yorick_stats())(1);
  479. }
  480.  
  481. func read_flat(f, how)
  482. {
  483.   local varCs, varCa, varSs, varSa, varIs, varIa, varLs, varLa;
  484.   local varFs, varFa, varDs, varDa, varZs, varZa, varSIs, varSIa;
  485.   local bundle;
  486.  
  487.   if (!how) {
  488.     restore, f;
  489.   } else {
  490.     restore, f, varFs, varCa, varDs, varSa;
  491.     varCs= f.varCs;
  492.     varFa= array(float, 3, 2);
  493.     varFa([4,6,2,5,3,1])= f.varFa([4,6,2,5,3,1]);
  494.     varSs= f.varSs;
  495.     varDa= array(double, 4,3,2);
  496.     varDa(4,1:3,::-1)= f.varDa(4,,::-1);
  497.     varDa(3:1:-1,..)= f.varDa(3:1:-1,..);
  498.     restore, f, varIs, varLs, varIa, varLa;
  499.     varZa= array(0i, 2);
  500.     varZa.re= f.varZa.re;
  501.     varZa.im= f.varZa.im;
  502.     varZs= f.varZs;
  503.     restore, f, bundle;
  504.     bundle.varDa= 0.0;
  505.     bundle.varZa= 0.0;
  506.     bundle.varDa(4,1:3,::-1)= f.varDa(4,,::-1);
  507.     bundle.varDa(3:1:-1,..)= f.varDa(3:1:-1,..);
  508.     bundle.varZa(1).re= f.bundle.varZa.re(1);
  509.     bundle.varZa(1).im= f.bundle.varZa.im(1);
  510.     bundle.varZa.re(2)= f.bundle.varZa(2).re;
  511.     bundle.varZa.im(2)= f.bundle.varZa(2).im;
  512.     varSIs= f.varSIs;
  513.     varSIa= array(Simple, 2);
  514.     varSIa(1).one= f.varSIa.one(1);
  515.     varSIa.one(2)= f.varSIa(2).one;
  516.     varSIa.two= f.varSIa.two;
  517.     varSIa.three= f.varSIa.three;
  518.   }
  519.   if (do_stats) "Restored "+print(yorick_stats())(1);
  520.  
  521.   goofs= [varCs!='A', varSs!=-37s, varIs!=76n, varLs!=144,
  522.       anyof(varCa!=['Z', '\370', 'a']),
  523.       anyof(varSa!=short([[0,0,0],[0,-100,100]])),
  524.       anyof(varIa!=int([[[1,2,3,4],[-30,-20,-10,0],[-1,2,-3,4]],
  525.                 [[0,-30,20,-10],[4,3,2,1],[3,-4,1,-2]]])),
  526.       anyof(varLa!=[123456789, -987654321]),
  527.       varFs!=1.5f, abs(varDs+6.022e23)>6.022e11, varZs!=1-1i,
  528.       anyof(varFa!=float([[0,0,0],[0,-100,100]])),
  529.       anyof(varDa!=double([[[1,2,3,4],[-30,-20,-10,0],[-1,2,-3,4]],
  530.                    [[0,-30,20,-10],[4,3,2,1],[3,-4,1,-2]]])),
  531.       anyof(varZa!=[123456789-3.5i, -987654321+0i]),
  532.  
  533.       struct_neq(varSIs, Simple(one='Q', two= -137., three= -37s)),
  534.       struct_neq(varSIa,
  535.              [varSIs, Simple(one='\370', two= 1.5, three= 37s)]),
  536.  
  537.       struct_neq(bundle,
  538.              Flat(varCs=varCs, varSs=varSs, varIs=varIs, varLs=varLs,
  539.               varCa=varCa, varSa=varSa, varIa=varIa, varLa=varLa,
  540.               varFs=varFs, varDs=varDs, varZs=varZs,
  541.               varFa=varFa, varDa=varDa, varZa=varZa,
  542.               varSIs=varSIs, varSIa=varSIa))];
  543.   if (anyof(goofs)) {
  544.     "read_flat failed -- goof flags are:";
  545.     goofs;
  546.   }
  547.  
  548.   if (do_stats) "Checked  "+print(yorick_stats())(1);
  549. }
  550.  
  551. func write_ptrs(f, how)
  552. {
  553.   extern varQs, varPs, varQa, varPa, linkedList, mixed;
  554.  
  555.   extern varCs, varZa, varFa, varDa;  /* referenced by ptrs */
  556.   varCs= 'A';
  557.   varFa= float([[0,0,0],[0,-100,100]]);
  558.   varDa= double([[[1,2,3,4],[-30,-20,-10,0],[-1,2,-3,4]],
  559.          [[0,-30,20,-10],[4,3,2,1],[3,-4,1,-2]]]);
  560.   varZa= [123456789-3.5i, -987654321+0i];
  561.  
  562.   /* invent a bunch of garbage to be written */
  563.   varQs= "Hello, world!";
  564.   varPs= pointer(varQs);
  565.   varQa= [["a", "bc"], ["def", "ghij"], ["klmn", "op"], [string(0), ""]];
  566.   varPa= [[[&varCs, &varDa], [&varZa, &varDa], [&varPs, &varDa]],
  567.       [[&varFa, &varDa], [&varDa, &varPs], [&varQa, &varQa]]];
  568.  
  569.   linkedList= &Link(name="second", index=2);
  570.   linkedList->next= &Link(next=linkedList, name="third", index=3);
  571.   linkedList->next->next= &Link(name="last", index=4);
  572.   linkedList= &Link(next=linkedList, name="first", index=1);
  573.  
  574.   mixed= Mixed(varPs=varPs, s=-37s, varQa=varQa, varQs=varQs,
  575.            links=linkedList, varPa=varPa);
  576.  
  577.   if (!how) {
  578.     /* This should produce maximum number of duped pointers.  */
  579.     if (!for_hist_test) save, f, complex, Link;
  580.     save, f, varQs, varQa, varPs, varPa, linkedList, mixed;
  581.   } else {
  582.     /* Piecemeal writes result in some pointee rewrites.  */
  583.     add_variable, f, -1, "varQs", string;
  584.     add_variable, f, -1, "varQa", "string", 2, 4;
  585.     add_variable, f, -1, "varPs", "pointer";
  586.     add_variable, f, -1, "varPa", pointer, [3,2,3,2];
  587.     save, f, complex, varQs;
  588.     f.varQa(,::-1)= varQa(,::-1);
  589.     f.varPs= varPs;
  590.     f.varPa(2,1:3)= varPa(2,1:3);
  591.     f.varPa(1,4:6)= varPa(1,4:6);
  592.     add_member, f, "Link", -1, "next", pointer;
  593.     add_member, f, "Link", -1, "name", "string";
  594.     add_member, f, "Link", -1, "index", "long";
  595.     install_struct, f, "Link";
  596.     add_variable, f, -1, "linkedList", "pointer";
  597.     save, f, mixed;
  598.     f.linkedList= linkedList;
  599.     f.varPa(2,4:6)= varPa(2,4:6);
  600.     f.varPa(1,1:3)= varPa(1,1:3);
  601.   }
  602.  
  603.   if (do_stats) "Saved ps "+print(yorick_stats())(1);
  604. }
  605.  
  606. func read_ptrs(f, how)
  607. {
  608.   local varQs, varPs, varQa, varPa, linkedList, mixed;
  609.  
  610.   extern varCs, varZa, varFa, varDa;  /* referenced by ptrs */
  611.  
  612.   if (!how) {
  613.     /* This should produce maximum number of duped pointers.  */
  614.     restore, f, varQs, varPs, varQa, varPa, linkedList, mixed;
  615.   } else {
  616.     /* Piecemeal reads result in some pointee rereads.  */
  617.     varQs= f.varQs;
  618.     varQa= array(string, 2, 4);
  619.     mixed= f.mixed;
  620.     varQa(,::-1)= f.varQa(,::-1);
  621.     varPa= array(pointer, 2, 3, 2);
  622.     varPa(1,::-1,2)= f.varPa(1,::-1,2);
  623.     linkedList= f.linkedList;
  624.     varPa(2,,2)= f.varPa(2,,2);
  625.     varPs= f.varPs;
  626.     varPa(..,1)= f.varPa(..,1);
  627.     mixed.varPa= &[];
  628.     mixed.varPa(::-1,..)= f.mixed.varPa(::-1,..)
  629.   }
  630.   if (do_stats) "Restored "+print(yorick_stats())(1);
  631.  
  632.   goofs= [varQs!="Hello, world!",
  633.       anyof(varQa!=[["a", "bc"], ["def", "ghij"],
  634.             ["klmn", "op"], [string(0), ""]]),
  635.       string(varPs)!="Hello, world!",
  636.       *varPa(1,1,1)!=varCs, anyof(*varPa(2,1,1)!=varDa),
  637.       anyof(*varPa(1,2,1)!=varZa), anyof(*varPa(2,2,1)!=varDa),
  638.       string(*varPa(1,3,1))!="Hello, world!", anyof(*varPa(2,3,1)!=varDa),
  639.       anyof(*varPa(1,1,2)!=varFa), anyof(*varPa(2,1,2)!=varDa),
  640.       anyof(*varPa(1,2,2)!=varDa), string(*varPa(2,2,2))!="Hello, world!",
  641.       anyof(*varPa(1,3,2)!=varQa), anyof(*varPa(2,3,2)!=varQa)];
  642.   if (anyof(goofs)) {
  643.     "read_ptrs failed on simple string or pointer -- goof flags are:";
  644.     goofs;
  645.   }
  646.  
  647.   ll1= linkedList;
  648.   ll3= linkedList->next->next;
  649.   goofs= [ll1->name!="first", ll1->index!=1,
  650.       ll1->next->name!="second", ll1->next->index!=2,
  651.       ll3->name!="third", ll3->index!=3,
  652.       ll3->next->name!="last", ll3->next->index!=4,
  653.       !is_void(*ll3->next->next)];
  654.   if (anyof(goofs)) {
  655.     "read_ptrs failed on linked list -- goof flags are:";
  656.     goofs;
  657.   }
  658.  
  659.   ll1= mixed.links;
  660.   ll3= mixed.links->next->next;
  661.   goofs= [ll1->name!="first", ll1->index!=1,
  662.       ll1->next->name!="second", ll1->next->index!=2,
  663.       ll3->name!="third", ll3->index!=3,
  664.       ll3->next->name!="last", ll3->next->index!=4,
  665.       !is_void(*ll3->next->next),
  666.       string(mixed.varPs)!="Hello, world!", mixed.s!=-37s,
  667.       anyof(mixed.varQa!=[["a", "bc"], ["def", "ghij"],
  668.                   ["klmn", "op"], [string(0), ""]]),
  669.       mixed.varQs!="Hello, world!",
  670.       anyof(*mixed.varPa(1,2,1)!=varZa),
  671.       anyof(*mixed.varPa(2,2,1)!=varDa),
  672.       string(*mixed.varPa(1,3,1))!="Hello, world!",
  673.       anyof(*mixed.varPa(2,3,1)!=varDa),
  674.       anyof(*mixed.varPa(1,1,2)!=varFa),
  675.       anyof(*mixed.varPa(2,1,2)!=varDa),
  676.       anyof(*mixed.varPa(1,2,2)!=varDa),
  677.       string(*mixed.varPa(2,2,2))!="Hello, world!",
  678.       anyof(*mixed.varPa(1,3,2)!=varQa),
  679.       anyof(*mixed.varPa(2,3,2)!=varQa)];
  680.   if (anyof(goofs)) {
  681.     "read_ptrs failed on mixed object -- goof flags are:";
  682.     goofs;
  683.   }
  684.  
  685.   if (do_stats) "Checkedp "+print(yorick_stats())(1);
  686. }
  687.  
  688. func struct_neq(x, y)
  689. {
  690.   members= strtok(strtok(print(structof(x))(2:-1))(2,)," (;")(1,);
  691.   m= numberof(members);
  692.   for (i=1 ; i<=m ; i++) {
  693.     xm= get_member(x, members(i));
  694.     ym= get_member(y, members(i));
  695.     if (typeof(xm)=="struct_instance") {
  696.       if (struct_neq(xm, ym)) return 1;
  697.     } else {
  698.       if (anyof(xm!=ym)) return 1;
  699.     }
  700.   }
  701.   return 0;
  702. }
  703.  
  704. struct Simple {
  705.   char one;
  706.   double two;
  707.   short three;
  708. }
  709.  
  710. struct Flat {
  711.   int varIs, varIa(4,3,2);
  712.   double varDs;
  713.   char varCs;
  714.   float varFs, varFa(3,2);
  715.   complex varZs, varZa(2);
  716.   short varSs, varSa(3,2);
  717.   double varDa(4,3,2);
  718.   Simple varSIs, varSIa(2);
  719.   long varLs, varLa(2);
  720.   char varCa(3);
  721. }
  722.  
  723. struct Link {
  724.   pointer next;
  725.   string name;
  726.   long index;
  727. }
  728.  
  729. struct Mixed {
  730.   pointer varPs;
  731.   short s;
  732.   string varQa(2,4), varQs;
  733.   pointer links, varPa(2,3,2);
  734. }
  735.  
  736. func pdcheck1(prefix)
  737. {
  738.   write, "Testing <- native...";
  739.   pdtest1_check, prefix+"-nat.db1";
  740.   write, "Testing <- cray...";
  741.   pdtest1_check, prefix+"-cray.db1";
  742.   write, "Testing <- dos...";
  743.   pdtest1_check, prefix+"-dos.db1";
  744.   write, "Testing <- mac...";
  745.   pdtest1_check, prefix+"-mac.db1";
  746.   write, "Testing <- mips...";
  747.   pdtest1_check, prefix+"-mips.db1";
  748.   write, "Testing <- sun3...";
  749.   pdtest1_check, prefix+"-sun3.db1";
  750.   write, "Testing <- sun4...";
  751.   pdtest1_check, prefix+"-sun4.db1";
  752.   write, "Testing <- vax...";
  753.   pdtest1_check, prefix+"-vax.db1";
  754. }
  755.  
  756. func pdcheck2
  757. {
  758.   write, "Testing sun_primitives db1 write...";
  759.   pdtest1_write,"junk.pdb", sun_primitives;
  760.   pdtest1_check,"junk.pdb";
  761.   write, "Testing dec_primitives db1 write...";
  762.   pdtest1_write,"junk.pdb", dec_primitives;
  763.   pdtest1_check,"junk.pdb";
  764.   write, "Testing cray_primitives db1 write...";
  765.   pdtest1_write,"junk.pdb", cray_primitives;
  766.   pdtest1_check,"junk.pdb";
  767.   write, "Testing mac_primitives db1 write...";
  768.   pdtest1_write,"junk.pdb", mac_primitives;
  769.   pdtest1_check,"junk.pdb";
  770.   write, "Testing macl_primitives db1 write...";
  771.   pdtest1_write,"junk.pdb", macl_primitives;
  772.   pdtest1_check,"junk.pdb";
  773.   write, "Testing pc_primitives db1 write...";
  774.   pdtest1_write,"junk.pdb", pc_primitives;
  775.   pdtest1_check,"junk.pdb";
  776.   write, "Testing sun3_primitives db1 write...";
  777.   pdtest1_write,"junk.pdb", sun3_primitives;
  778.   pdtest1_check,"junk.pdb";
  779.   write, "Testing vax_primitives db1 write...";
  780.   pdtest1_write,"junk.pdb", vax_primitives;
  781.   pdtest1_check,"junk.pdb";
  782.   write, "Testing vaxg_primitives db1 write...";
  783.   pdtest1_write,"junk.pdb", vaxg_primitives;
  784.   pdtest1_check,"junk.pdb";
  785.   write, "Testing xdr_primitives db1 write...";
  786.   pdtest1_write,"junk.pdb", xdr_primitives;
  787.   pdtest1_check,"junk.pdb";
  788.   write, "Testing sun_primitives db1 write w/PDB-style pointers...";
  789.   pdtest1_write,"junk.pdb", sun_primitives, 1;
  790.   pdtest1_check,"junk.pdb";
  791.   write, "Testing dec_primitives db1 write w/PDB-style pointers...";
  792.   pdtest1_write,"junk.pdb", dec_primitives, 1;
  793.   pdtest1_check,"junk.pdb";
  794.   write, "Testing cray_primitives db1 write w/PDB-style pointers...";
  795.   pdtest1_write,"junk.pdb", cray_primitives, 1;
  796.   pdtest1_check,"junk.pdb";
  797.   write, "Testing native db1 write...";
  798.   pdtest1_write,"junk.pdb";
  799.   pdtest1_check,"junk.pdb";
  800. }
  801.  
  802. func pdtest1_check(filename)
  803. {
  804.   f= openb(filename);
  805.   vars= *get_vars(f)(1);
  806.   if (numberof(vars)!=15) write, "Should be 15 variables in "+filename;
  807.  
  808.   local cs, ss, is, fs, ds, ca, sa, ia, fa2, da, cap, fa2_app, fs_app;
  809.   local view, graph;
  810.   restore, f;
  811.  
  812.   if (typeof(cs)!="char" || dimsof(cs)(1)!=0 || cs!='Q' /* 0x51 */)
  813.     write, "variable cs bad in "+filename;
  814.   if (typeof(ss)!="short" || dimsof(ss)(1)!=0 || ss!=-514)
  815.     write, "variable ss bad in "+filename;
  816.   if (typeof(is)!="int" || dimsof(is)(1)!=0 || is!=10)
  817.     write, "variable is bad in "+filename;
  818.   if (typeof(fs)!="float" || dimsof(fs)(1)!=0 || float_neq(fs,3.14159))
  819.     write, "variable fs bad in "+filename;
  820.   if (typeof(ds)!="double" || dimsof(ds)(1)!=0 || double_neq(ds,exp(1)))
  821.     write, "variable ds bad in "+filename;
  822.  
  823.   if (typeof(ca)!="char" || dimsof(ca)(1)!=1 || dimsof(ca)(2)!=10 ||
  824.       string(&ca)!="Hi there!")
  825.     write, "variable ca bad in "+filename;
  826.   if (typeof(sa)!="short" || dimsof(sa)(1)!=1 || dimsof(sa)(2)!=5 ||
  827.       anyof(sa!=[2,1,0,-1,-2]))
  828.     write, "variable sa bad in "+filename;
  829.   if (typeof(ia)!="int" || dimsof(ia)(1)!=1 || dimsof(ia)(2)!=5 ||
  830.       anyof(ia!=[-2,-1,0,1,2]))
  831.     write, "variable ia bad in "+filename;
  832.   if (typeof(fa2)!="float" || dimsof(fa2)(1)!=2 ||
  833.       anyof(dimsof(fa2)!=[2,3,4]) ||
  834.       anyof(float_neq(fa2, [[1,1,1],[2,4,8],[3,9,27],[4,16,64]])))
  835.     write, "variable fa2 bad in "+filename;
  836.   if (typeof(da)!="double" || dimsof(da)(1)!=1 || dimsof(da)(2)!=4 ||
  837.       anyof(double_neq(da, exp([1,2,3,4]))))
  838.     write, "variable da bad in "+filename;
  839.  
  840.   if (typeof(cap)!="pointer" || dimsof(cap)(1)!=1 ||  dimsof(cap)(2)!=3 ||
  841.       typeof(*cap(1))!="char" || string(cap(1))!="lev1" ||
  842.       typeof(*cap(2))!="char" || string(cap(2))!="lev2" ||
  843.       typeof(*cap(3))!="char" || string(cap(3))!="tar fu blat")
  844.     write, "variable cap bad in "+filename;
  845.  
  846.   if (typeof(fs_app)!="float" || dimsof(fs_app)(1)!=0 ||
  847.       float_neq(fs_app,-3.14159))
  848.     write, "variable fs_app bad in "+filename;
  849.   if (typeof(fa2_app)!="float" || dimsof(fa2_app)(1)!=2 ||
  850.       anyof(dimsof(fa2_app)!=[2,3,4]) ||
  851.       anyof(float_neq(fa2_app, [[1,2,3],[1,4,9],[1,8,27],[1,16,81]])))
  852.     write, "variable fa2_app bad in "+filename;
  853.  
  854.   if (nameof(structof(view))!="l_frame" || dimsof(view)(1)!=0 ||
  855.       float_neq(view.x_min,0.1) || float_neq(view.x_max,1.0) ||
  856.       float_neq(view.y_min,-0.5) || float_neq(view.y_max,0.5))
  857.     write, "variable view bad in "+filename;
  858.  
  859.   if (nameof(structof(graph))!="plot" || dimsof(graph)(1)!=0 ||
  860.       anyof(float_neq(graph.x_axis,[0,.1,.2,.3,.4,.5,.6,.7,.8,.9])) ||
  861.       anyof(float_neq(graph.y_axis,[.5,.4,.3,.2,.1,0,-.1,-.2,-.3,-.4])) ||
  862.       float_neq(graph.view.x_min,0.1) || float_neq(graph.view.x_max,1.0) ||
  863.       float_neq(graph.view.y_min,-0.5) || float_neq(graph.view.y_max,0.5) ||
  864.       graph.npts!=10 || string(graph.label)!="test graph")
  865.     write, "variable graph bad in "+filename;
  866. }
  867.  
  868. func float_neq(a, b)
  869. {
  870.   return abs(a-b)/(abs(a)+abs(b)+1.e-99) > 1.e-6;
  871. }
  872.  
  873. func double_neq(a, b)
  874. {
  875.   return abs(a-b)/(abs(a)+abs(b)+1.e-99) > 1.e-12;
  876. }
  877.  
  878. struct l_frame {
  879.   float x_min, x_max, y_min, y_max;
  880. }
  881.  
  882. struct plot {
  883.   float x_axis(10), y_axis(10);
  884.   int npts;
  885.   pointer label;
  886.   l_frame view;
  887. }
  888.  
  889. func pdtest1_write(filename, primitives, pdbptrs)
  890. {
  891.   cs= 'Q';
  892.   ss= -514s;
  893.   is= 10n;
  894.   fs= 3.14159;
  895.   ds= exp(1);
  896.  
  897.   ca= *pointer("Hi there!");
  898.   sa= [2s,1s,0s,-1s,-2s];
  899.   ia= [-2n,-1n,0n,1n,2n];
  900.   fa2= [[1.f,1.f,1.f],[2.f,4.f,8.f],[3.f,9.f,27.f],[4.f,16.f,64.f]];
  901.   da= exp([1,2,3,4]);
  902.  
  903.   cap= [pointer("lev1"), pointer("lev2"), pointer("tar fu blat")];
  904.  
  905.   fs= 3.14159f;
  906.  
  907.   view= l_frame(x_min=0.1,x_max=1.0,y_min=-0.5,y_max=0.5);
  908.   graph= plot(x_axis=[0,.1,.2,.3,.4,.5,.6,.7,.8,.9],
  909.           y_axis=[.5,.4,.3,.2,.1,0,-.1,-.2,-.3,-.4],
  910.           npts=10, label=pointer("test graph"),
  911.           view=view);
  912.  
  913.   fa2_app= float([[1,2,3],[1,4,9],[1,8,27],[1,16,81]]);
  914.   fs_app= -3.14159f;
  915.  
  916.   if (!pdbptrs) {
  917.     save, createb(filename, primitives),\
  918.       cs,ss,is,fs,ds, ca,sa,ia,fa2,da, cap, view,graph;
  919.   } else {
  920.     f= createb(filename, primitives);
  921.     save, f, l_frame;
  922.     add_member, f, "plot", -1, "x_axis", float, 10;
  923.     add_member, f, "plot", -1, "y_axis", float, 10;
  924.     add_member, f, "plot", -1, "npts", int;
  925.     add_member, f, "plot", -1, "label", "char *";
  926.     add_member, f, "plot", -1, "view", l_frame;
  927.     install_struct, f, "plot";
  928.     save, f, cs,ss,is,fs,ds, ca,sa,ia,fa2,da;
  929.     add_variable, f, -1, "cap", "char*", 3;
  930.     save, f, cap, view,graph;
  931.     close, f;
  932.   }
  933.   save, updateb(filename), fa2_app,fs_app;
  934. }
  935.